home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / var / lib / dpkg / info / dictionaries-common.config < prev    next >
Text File  |  2008-06-04  |  20KB  |  595 lines
  1. #!/usr/bin/perl -w
  2. # -------------------------------------------------------------------------------
  3. # dictionaries-common.config-base:
  4. #  dc-debconf-select.pl will be added to the end of this file
  5. #  to make dictionaries-common.config
  6. # -------------------------------------------------------------------------------
  7.  
  8. use Debconf::Client::ConfModule q(:all);
  9.  
  10. version ('2.0');
  11.  
  12. if ( -l "/etc/dictionary" ) {
  13.   input ("medium","dictionaries-common/old_wordlist_link");
  14. }
  15.  
  16. if ( not -l "/usr/dict" ){
  17.   set("dictionaries-common/remove_old_usr_dict_link","false");
  18. }
  19.  
  20. go();
  21.  
  22. # Trying to find a reasonable guess for default ispell dictionary and wordlist
  23. # from the debian-installer settings, envvars or pre-policy symlinks and the
  24. # list of ispell dictionaries and wordlists to be installed
  25.  
  26. $priority{"ispell"}   = "critical";
  27. $priority{"wordlist"} = "critical";
  28. $di_language          = "debian-installer/language";
  29. $di_country           = "debian-installer/country";
  30. $dcscript             = "/usr/share/dictionaries-common/dc-debconf-select.pl";
  31. $fromdcconfig         = "yes";
  32. $debug                = "yes" if exists $ENV{'DICT_COMMON_DEBUG'};
  33.  
  34.  
  35. my %debconf_vals = ();
  36. my @suffixes     = ("","-large","-medium","-small","-gut");
  37. my %equivs       = ("bg"      => "bulgarian",
  38.             "ca"      => "catalan",
  39.             "cs"      => "czech",
  40.             "da"      => "danish",
  41.             "de"      => "ngerman",
  42.             "de:1"    => "ogerman",
  43.             "de_CH"   => "swiss",
  44.             "en_US"   => "american",
  45.             "en_US:1" => "miscfiles",
  46.             "en_CA"   => "canadian",
  47.             "en_CA:1" => "american",
  48.             "en_GB"   => "british",
  49.             "en_AU"   => "british",
  50.             "eo"      => "esperanto",
  51.             "es"      => "spanish",
  52.             "fi"      => "finnish",
  53.             "fo"      => "faroese",
  54.             "fr"      => "french",
  55.             "ga"      => "irish",
  56.             "gd"      => "gaelic",
  57.             "gl"      => "galician-minimos",
  58.             "gv"      => "manx",
  59.             "hu"      => "hungarian",
  60.             "it"      => "italian",
  61.             "lt"      => "lithuanian",
  62.             "nb"      => "norwegian->bokmal",
  63.             "nl"      => "dutch",
  64.             "nn"      => "norwegian->nynorsk",
  65.             "pl"      => "polish",
  66.             "pt"      => "portuguese",
  67.             "pt_BR"   => "brazilian",
  68.             "ru"      => "russian",
  69.             "sv"      => "swedish",
  70.             "tl"      => "tagalog",
  71.             "uk"      => "ukrainian");
  72. my %pending_keys   = ();
  73. my %reverse_equivs = ();
  74. my %alternatives   = ("ispell"   => "ispell-dictionary.hash",
  75.               "wordlist" => "dictionary");
  76.  
  77. # -------------------------------------------------------------
  78. sub dc_debugprint(){
  79. # -------------------------------------------------------------
  80. # Show info if in debug mode
  81. # -------------------------------------------------------------
  82.   print STDERR "@_" if $debug;
  83. }
  84.  
  85. # -------------------------------------------------------------
  86. sub dc_set (){
  87. # -------------------------------------------------------------
  88. # Set debconf value unless already set
  89. # -------------------------------------------------------------
  90.   my $question  = shift;
  91.   my $value     = shift;
  92.   my $priority  = $priority{$class} || "";
  93.  
  94.   my ($errorcode, $oldvalue) = get($question);
  95.  
  96.   $oldvalue = "unset" unless $oldvalue;
  97.  
  98.   if ( $errorcode or $oldvalue eq "unset" ){
  99.     &dc_debugprint("  $question: errorcode: $errorcode; priority: $priority\n" .
  100.            "  Old:[$oldvalue] --> New:[$value]\n");
  101.     set("$question","$value");
  102.   } elsif ( $oldvalue eq $value ) {
  103.     print STDERR "Info: $question is already set to
  104.       [$oldvalue]. Preserving it.\n";
  105.   } else {
  106.     print STDERR "Warning: $question is already set to
  107.       [$oldvalue].
  108.       Not setting to [$value]\n";
  109.   }
  110.  
  111.   if ( $debug ){                 # --- Check if question value is actually set
  112.     ($errorcode, $oldvalue) = get($question);
  113.     if ( $errorcode ){
  114.       print STDERR "dictionaries-common: $question reading failed with $errorcode\n";
  115.     } elsif ( $oldvalue) {
  116.       print STDERR "dictionaries-common: $question actually set to [$oldvalue]\n";
  117.     } else {
  118.       print STDERR "dictionaries-common: $question value is void, bad thing\n";
  119.     }
  120.   }
  121.   &dc_debugprint ("Not tried: " . join(', ',sort keys %pending_keys) . "\n---\n");
  122. }
  123.  
  124. # -------------------------------------------------------------
  125. sub extractlangname (){
  126. # -------------------------------------------------------------
  127. # Look if a dict matching $langkey in %equivs is to be installed
  128. # and return the preferred language name if so.
  129. # -------------------------------------------------------------
  130.   my $langkey    = shift;
  131.   my $thestring  = '';
  132.   my $thepackage = '';
  133.   my $thevariant = '';
  134.   my @thevalues  = ();
  135.  
  136.   if ( exists $pending_keys{$langkey} ){ # Make sure we do not try it again
  137.     &dc_debugprint("Trying langkey $langkey\n");
  138.     delete $pending_keys{$langkey};
  139.   } else {
  140.     if ( exists $equivs{$langkey} ){
  141.       # This $langkey was already tried, no need to try it again
  142.       &dc_debugprint("Already done langkey $langkey\n");
  143.     } else {
  144.       # This $langkey does not exist
  145.       &dc_debugprint("Non-existant langkey $langkey\n");
  146.     }
  147.     return;
  148.   }
  149.  
  150.   if ( exists $equivs{$langkey} ){
  151.     ($thepackage,$thevariant) = split ("->",$equivs{$langkey});
  152.     foreach $suffix ( @suffixes ){
  153.       if ( $thepackage eq "miscfiles" ){
  154.     $pkgfullname = "$thepackage$suffix";
  155.       } else {
  156.     $pkgfullname = "$classprefix$thepackage$suffix";
  157.       }
  158.       &dc_debugprint(" Trying package $pkgfullname\n");
  159.       if ( exists $debconf_vals{"$pkgfullname"} ){
  160.     if ( exists $debconf_defaultvals{"$pkgfullname"} ){
  161.       $thestring = $debconf_defaultvals{"$pkgfullname"};
  162.     } else {
  163.       $thestring = $debconf_vals{"$pkgfullname"};
  164.     }
  165.     @thevalues = sort split (/\s*,\s*/,$thestring);
  166.     if ( $thevariant ){
  167.       @thevalues = grep {/$thevariant/i} @thevalues;
  168.     }
  169.     @thevalues = sort {
  170.       $a =~ m/tex/i <=> $b =~ m/tex/i # Sort tex variants last
  171.         ||
  172.       $a cmp $b } @thevalues;
  173.     if ( scalar @thevalues >= 1 ){
  174.       return "$thevalues[0]";
  175.     } else {
  176.       return;
  177.     }
  178.       }
  179.     }
  180.   }
  181. }
  182.  
  183. # -------------------------------------------------------------
  184. sub guesslang (){
  185. # -------------------------------------------------------------
  186. # Try different combinations of $language and $country and possible
  187. # fallbacks in case extractlangname() does not find a good guess
  188. # -------------------------------------------------------------
  189.   my $class     = shift;
  190.   my $language  = shift;
  191.   my $country   = shift;
  192.   my $guessed   = '';
  193.   my @possible_fallbacks = ();
  194.  
  195.   if ( $guessed = &extractlangname("$language" . "_" . uc($country))
  196.        || &extractlangname("$language" . "_" . uc("$country") . ":1")
  197.        || &extractlangname("$language")
  198.        || &extractlangname("$language:1")
  199.        ){
  200.     $priority{$class} = "low";
  201.     return $guessed;
  202.   } else {
  203.     @possible_fallbacks = grep {/$language\_/} sort keys %equivs;
  204.     $priority{$class} = "medium";
  205.     foreach ( @possible_fallbacks ){
  206.       return $guessed if ( $guessed = &extractlangname($_));
  207.     }
  208.     $priority{$class} = "high";
  209.     return;
  210.   }
  211. }
  212.  
  213. # -------------------------------------------------------------
  214. sub guessotherlang (){
  215. # -------------------------------------------------------------
  216. # Iterate over the not yet tried $langkey values for a dict to be
  217. # installed. Return first match
  218. # -------------------------------------------------------------
  219.   my $guessed = '';
  220.  
  221.   foreach ( sort keys %pending_keys ){
  222.     return $guessed if ( $guessed = &extractlangname($_));
  223.   }
  224. }
  225.  
  226. # -------------------------------------------------------------
  227. sub guesslang4link(){
  228. # -------------------------------------------------------------
  229. # Try guessing default value after (woody or older) former symlink
  230. # -------------------------------------------------------------
  231.   my $class      = shift;
  232.   my $prefix     = '';
  233.   my $guess      = '';
  234.   my $language   = '';
  235.   my $link       = "/etc/alternatives/$alternatives{$class}";
  236.  
  237.   return if not ( -l $link );
  238.  
  239.   if ( $guess = readlink($link) ){
  240.  
  241.     &dc_debugprint("Found link $guess. ");
  242.  
  243.     $guess =~ s/\.hash$//;
  244.     $guess =~ s/^.*\///;
  245.     $guess =~ s/(\-\.)(small|medium|large)$//;
  246.     $guess =~ s/\-english$//;
  247.  
  248.     $guess = "norwegian->bokmal"  if ($guess eq "bokmσl");
  249.     $guess = "norwegian->nynorsk" if ($guess eq "nynorsk");
  250.     $guess = "ogerman"            if ($guess eq "german");
  251.     $guess = "miscfiles"          if ($guess eq "web2");
  252.     $guess = "danish"             if ($guess eq "dansk");
  253.     $guess = "french"             if ($guess eq "francais");
  254.     $guess = "swedish"            if ($guess eq "svenska");
  255.  
  256.     &dc_debugprint("Fine tuned to $guess.\n");
  257.  
  258.     if ( exists $reverse_equivs{$guess} ){
  259.       $language = $reverse_equivs{$guess};
  260.     } else {
  261.       return;
  262.     }
  263.     return $guessed if ( $guessed = &extractlangname($language) );
  264.   }
  265.   return;
  266. }
  267.  
  268. # -------------------------------------------------------------
  269. sub dc_manual_alternative (){
  270. # -------------------------------------------------------------
  271. # Check if woody (or older) alternative exists and is set to manual
  272. # -------------------------------------------------------------
  273.   my $class  = shift;
  274.   my $file   = "/var/lib/dpkg/alternatives/$alternatives{$class}";
  275.   my $status = '';
  276.  
  277.   if ( -r $file ){
  278.     open(FILE,"< $file") or return;
  279.     $status = <FILE>;
  280.     close FILE;
  281.     $status = "" unless $status;
  282.     chomp $status;
  283.     return "Manual (previous alternative setting)" if ( $status eq "manual" );
  284.   }
  285. }
  286.  
  287. # -------------------------------------------------------------
  288. sub dc_debconf_rebuild (){
  289. # -------------------------------------------------------------
  290. # Gather info from debconf for the (to be) installed packages for class
  291. #   %debconf_vals         : pkg -> languages provided by package
  292. #   %debconf_defaultvals  : pkg -> default language for package
  293. # -------------------------------------------------------------
  294.   my $class = shift;
  295.   return unless $class;
  296.   my $question = "shared/packages-$class";
  297.   my ($errorcode,$pkgowners) = metaget ($question, "owners");
  298.   return if $errorcode;
  299.  
  300.   %debconf_vals = ();
  301.   %debconf_defaultvals = ();
  302.   foreach ( split (/\s*,\s*/,$pkgowners) ){
  303.     #$debconf_vals{$_} = metaget ("$_/languages", "default");
  304.     $debconf_vals{$_} = get ("$_/languages");
  305.     my ($errorcode,$pkgdefaults) = get ("$_/defaults");
  306.     $debconf_defaultvals{$_} = $pkgdefaults if not $errorcode;
  307.   }
  308.   return "ok";
  309. }
  310.  
  311. # -----------------------------------------------------------------
  312.  
  313. &dc_debugprint("dictionaries-common: (re)configuring ...\n");
  314.  
  315. if ( not -e $dcscript ){
  316.   if ( -e "/etc/default/locale" ){
  317.     $language = $ENV{'LANG'} if exists $ENV{'LANG'};
  318.   }
  319.   &dc_debugprint("LANG is set to $language\n") if $language;
  320.   unless ( $language ){
  321.     ($errorcode,$language) = get($di_language);
  322.     $language = '' if $errorcode;
  323.     &dc_debugprint("Debconf gives language: $language\n") if $language;
  324.   }
  325.   unless  ( readlink ("/etc/alternatives/ispell-dictionary.hash") ||
  326.         readlink ("/etc/alternatives/dictionary")){
  327.     $language = $language ||
  328.     $ENV{'LANG'} ||
  329.     $ENV{'LC_MESSAGES'} ||
  330.     $ENV{'LC_ALL'} ||
  331.     '';
  332.   }
  333.   if ( $language ){                # Installing from scratch
  334.     $language = "en" if ( $language eq "C" );
  335.     # Deal with de_DE:de_DE@euro:de:en_GB.UTF-8:en like entries
  336.     $language = ( split(":",$language) )[0];
  337.     $language =~ s/[\.@].*$//;                # Remove variant and charset
  338.     ($language,$country) = split("_",$language);
  339.     if ( not $country ){
  340.       ($errorcode,$country) = get($di_country);
  341.       if ( $errorcode or not $country ){
  342.     $country = "unset";
  343.       }
  344.     }
  345.     foreach $class ("ispell","wordlist"){
  346.       $classprefix = substr($class,0,1);
  347.       if ( &dc_debconf_rebuild($class) ){
  348.     %pending_keys = %equivs;
  349.     if ( $guessed = &guesslang($class,$language,$country) ){
  350.       &dc_debugprint("* Guessed [d-i]->($class,$language,$country)\n");
  351.       &dc_set("dictionaries-common/default-$class","$guessed");
  352.     } else {
  353.       if ( $guessed = &guesslang($class,"en","US")
  354.            || &guessotherlang ){
  355.         &dc_debugprint("*** Forcing [$guessed] for ($class,$language,$country) ***\n");
  356.         $priority{$class} = "medium";
  357.         &dc_set("dictionaries-common/default-$class","$guessed");
  358.         &dc_debugprint("** --- **\n");
  359.       } else {
  360.         &dc_debugprint("* Nothing found\n");
  361.         $priority{$class} = "critical";
  362.       }
  363.     }
  364.       }
  365.     }
  366.   } else {                  # Upgrading from woody or previous release
  367.     foreach ( keys %equivs ){
  368.       $reverse_equivs{$equivs{$_}} = $_;
  369.     }
  370.     &dc_debugprint("dictionaries-common: Trying pre-sarge symlinks\n");
  371.     foreach $class ("ispell","wordlist"){
  372.       $classprefix = substr($class,0,1);
  373.       if ( &dc_debconf_rebuild($class) ){
  374.     %pending_keys = %equivs;
  375.     if ( $guessed = &guesslang4link($class) ){
  376.       if ( &dc_manual_alternative($class) ){
  377.         &dc_debugprint("- $class was in manual mode. Setting critical priority\n");
  378.         $priority{$class} = "critical";
  379.       } else {
  380.         $priority{$class} = "low";
  381.         foreach ( keys %debconf_vals ){
  382.           my $oldpackage = $_;
  383.           next if ( $oldpackage eq "dictionaries-common" );
  384.           $oldpackage = "wenglish" if ( $oldpackage eq "wamerican" );
  385.           # critical priority if exists debconf entry without a
  386.           # previous package installed. This means that besides
  387.           # upgrading, new dicts are being installed.
  388.           if ( not -e "/var/lib/dpkg/info/$oldpackage.list" ){
  389.         $priority{$class} = "critical";
  390.         &dc_debugprint("* New dict [$oldpackage] is to be installed\n");
  391.         last;
  392.           }
  393.         }
  394.       }
  395.       &dc_set("dictionaries-common/default-$class","$guessed");
  396.     }
  397.       }
  398.     }
  399.   }
  400. }
  401.  
  402. # Unregistering no longer used dictionaries-common/languages and
  403. # dictionaries-common ownership of other two shared questions
  404.  
  405. unregister("dictionaries-common/languages");
  406. unregister("shared/packages-ispell");
  407. unregister("shared/packages-wordlist");
  408.  
  409. # Prompting the questions if required
  410.  
  411. if ( not -e $dcscript ){             # First dictionaries-common installation
  412.   foreach $class ("ispell","wordlist"){
  413.     &dc_debconf_select($class,$priority{$class});
  414.     # This might have been pre-seeded and question not asked.
  415.     # Make sure question is tagged as seen in this case
  416.     if ( $priority{$class} ne "critical" ){
  417.       fset ("dictionaries-common/default-$class", "seen", "true");
  418.       go();
  419.     }
  420.   }
  421. } else {                              # Reconfiguring or upgrading
  422.   foreach $class ("ispell","wordlist"){
  423.     &dc_debconf_select($class);
  424.   }
  425. }
  426.  
  427. &dc_debugprint("dictionaries-common: (re)configuring ...Done.\n");
  428.  
  429. # Local Variables:
  430. # perl-indent-level: 2
  431. # coding: iso-8859-1
  432. # End:
  433.  
  434. # -------------------------------------------------------------------------------
  435. # dc-debconf-select.pl:
  436. #  This file will be added to end of dictionaries-common.config-base
  437. #  to make dictionaries-common.config, as well as installed under
  438. #  /usr/share/dictionaries-common for single ispell dicts/wordlists use
  439. # -------------------------------------------------------------------------------
  440.  
  441. sub dico_get_packages (){
  442.   # Get list of packages sharing the question
  443.   my $class    = shift;
  444.   my $question = "shared/packages-$class";
  445.  
  446.   my ($errorcode,$packages) = metaget ($question, "owners");
  447.   return [ split (/\s*,\s*/, $packages) ] unless $errorcode;
  448. }
  449.  
  450. sub dico_parse_languages (){
  451.   # Get a hash reference of package -> list of (e)languages provided by package
  452.   my $class    = shift;
  453.   my $variant  = shift;
  454.   my $packages = shift;
  455.   my %tmphash  = ();
  456.  
  457.   die "No variant (languages|elanguages) string supplied\n" unless $variant;
  458.  
  459.   $packages = &dico_get_packages($class) unless $packages;
  460.  
  461.   foreach $pkg ( @$packages ){
  462.     my ($errorcode, $entry ) = metaget("$pkg/$variant", "default");
  463.     unless ( $errorcode ){
  464.       $entry =~ s/^\s+//;
  465.       $entry =~ s/\s+$//;
  466.       $tmphash{$pkg} = $entry;
  467.     }
  468.   }
  469.   return \%tmphash;
  470. }
  471.  
  472. sub dico_get_all_choices (){
  473.   # Get $choices and $echoices parallel lists sorted after $echoices and formatted for debconf
  474.   my $class       = shift;
  475.   my $languages   = shift;
  476.   my $debug       = 1 if exists $ENV{'DICT_COMMON_DEBUG'};
  477.   my %mappinghash = ();
  478.   my $debug_prefix = "[dico_get_all_choices]";
  479.  
  480.   $languages   = &dico_parse_languages($class,"languages") unless $languages;
  481.  
  482.   my $elanguages  = &dico_parse_languages($class,"elanguages",[ keys %$languages ]);
  483.  
  484.   if ( $debug ){
  485.     print STDERR "-------- $debug_prefix start --------\n";
  486.     my $langlist  = join(', ',sort keys %{$languages});
  487.     my $elanglist = join(', ',sort keys %{$elanguages});
  488.     print STDERR " * Packages with languages: $langlist\n"  if $debug;
  489.     print STDERR " * Packages with elanguages: $elanglist\n" if $debug;
  490.   }
  491.  
  492.   foreach $pkg ( keys %$languages ){
  493.     my @langs  = split(/\s*,\s*/, $languages->{$pkg});
  494.     my @elangs = @langs;
  495.     if ( exists $elanguages->{$pkg} ){
  496.       my @tmp = split(/\s*,\s*/, $elanguages->{$pkg});
  497.       if ( $debug ){
  498.     print STDERR " langs: $#langs, "  . join(', ',@langs)  . "\n";
  499.     print STDERR " tmp:   $#tmp, "    . join(', ',@tmp)    . "\n";
  500.       }
  501.       @elangs = @tmp if ( $#langs == $#tmp );
  502.     }
  503.     foreach $index ( 0 .. $#langs ){
  504.       $mappinghash{$langs[$index]} = $elangs[$index];
  505.     }
  506.   }
  507.   my $echoices = join(', ', sort {lc($a) cmp lc($b)} values %mappinghash);
  508.   my $choices  = join(', ',
  509.               sort {lc($mappinghash{$a}) cmp lc($mappinghash{$b})}
  510.               keys %mappinghash);
  511.   if ( $debug ){
  512.     print STDERR "- Choices:\n[$choices]\n";
  513.     print STDERR "- Echoices:\n[$echoices]\n";
  514.     print STDERR "-------- $debug_prefix end --------\n";
  515.   }
  516.   return $choices, $echoices;
  517. }
  518.  
  519. sub dc_debconf_select (){
  520.   my $class       = shift;
  521.   my $priority    = shift;
  522.   my $question    = "dictionaries-common/default-$class";
  523.   my $packages    = &dico_get_packages($class);
  524.   my $debug       = 1 if exists $ENV{'DICT_COMMON_DEBUG'};
  525.   my $reconfigure = 1 if exists $ENV{'DEBCONF_RECONFIGURE'};
  526.   my $echoices;
  527.   my @oldchoices  = ();
  528.   my %newchoices  = ();
  529.   my %title       = ('ispell'   => "Dictionaries-common: Ispell dictionary",
  530.              'wordlist' => "Dictionaries-common: Wordlist dictionary"
  531.              );
  532.  
  533.   return unless $packages;
  534.  
  535.   # Get new base list of provided languages
  536.   my $languages = &dico_parse_languages($class,"languages",$packages);
  537.   foreach $pkg ( keys %$languages ) {
  538.     foreach $lang ( split(/\s*,\s*/, $languages->{$pkg}) ){
  539.       $newchoices{$lang}++;
  540.     }
  541.   }
  542.   my $choices = join (', ', sort {lc($a) cmp lc($b)} keys %newchoices);
  543.  
  544.   # Read current value of default ispell dict / wordlist. No need to have
  545.   # critical priority if is in the new list or set to manual. Otherwise
  546.   # ask with critical priority, name for current value is changed or
  547.   # something wrong happened.
  548.   my $curval  = get ($question) || "undefined";
  549.   unless ( $priority ){
  550.     if ( $curval =~ /^Manual.*/ or exists $newchoices{$curval} ){
  551.       $priority = "medium";     #
  552.     } else {
  553.       $priority = "medium"; # No good value, ask. Do not change!!
  554.     }
  555.   }
  556.  
  557.   # Get old list of provided languages
  558.   @oldchoices = split(/\s*,\s*/,metaget ($question, "choices-c"));
  559.   pop @oldchoices;            # Remove the manual entry
  560.   my $oldchoices = join (', ', sort {lc($a) cmp lc($b)} @oldchoices);
  561.   print STDERR
  562.     "** dc_debconf_select: $class, $priority, $question\n" .
  563.     "   new choices:[$choices]\n   old choices:[$oldchoices]\n" if $debug;
  564.  
  565.   # May ask question if there is no match
  566.   if ( scalar %newchoices ) {
  567.     fset ($question, "seen", "false") if ( $choices ne $oldchoices);
  568.     my ( $errorcode, $seen ) = fget($question, "seen");
  569.     if ( $seen eq "false" or $reconfigure ){
  570.       ($choices, $echoices ) = &dico_get_all_choices($class,$languages);
  571.       subst ($question, "choices", $choices);
  572.       subst ($question, "echoices", $echoices);
  573.     }
  574.     input ($priority, $question);
  575.     title ($title{$class});
  576.     go ();
  577.     subst ($question, "echoices", $choices); # Be backwards consistent
  578.   }
  579.  
  580.   # If called from dictionaries-common.config, check actual values in debug mode
  581.   if ( $debug && $fromdcconfig ){
  582.     print STDERR "** dictionaries-common.config: Checking some real values for $question\n";
  583.     print STDERR "   Real new Choices-C: " . metaget ($question, "choices-c") . "\n";
  584.     print STDERR "   Real new value: "  . get ($question) . "\n";
  585.     print STDERR "---\n";
  586.   }
  587. }
  588.  
  589. # Local Variables:
  590. # perl-indent-level: 2
  591. # End:
  592.  
  593. 1;
  594.  
  595.